home *** CD-ROM | disk | FTP | other *** search
- .title k11rtd wildcard directory lookup for RT11
- .ident /2.17/
-
- ; 18-Jun-84 16:33:01 Brian Nelson
- ;
- ;
- ; Copyright (C) 1984 Change Software, Inc
- ;
- ; 17-Sep-86 13:23:00 Handle Labels stuffed in by VMS Exchange
-
-
- ; Include things we want for kermit
-
-
-
- .if ndf, K11INC
- .ift
- .include /IN:K11MAC.MAC/
- .endc
-
- .iif ndf, k11inc, .error ; .INCLUDE failed
-
- .psect
-
- .enabl gbl
-
-
-
-
-
-
-
-
-
-
- .sbttl local data offsets and definitions
-
-
- .mcall .csispc ,.dstat ,.fetch ,.lookup,.readw ,.close ,.cstat
- .mcall .serr ,.herr ,.purge
-
- topmem = 50
- errbyt = 52
-
- DEV$LD = 46 ;/45/ LD: identification
-
- tent = 400 ; status for a tentative file
- empty = 1000 ; status for an empty entry
- perm = 2000 ; status bit for a permanent file
- endseg = 4000 ; end of a segment bits
-
- ;; star = 134745 ; from .csispc for a '*' (rt11/rsts)
- star = 132500 ; from .csispc for a '*' (real RT11)
-
- .psect rtdir ,rw,d,lcl,rel,con
-
-
- hd$blk = 1 ; vbn of the home block
- hd$fir = 724 ; offset into home block for first block
- hd$vol = 730 ; RT11A and seven spaces usually
- hd$sys = 760 ; always DECRT11A
-
-
- outlun: .word 0
- dirbuf: .blkb 2000 ; 2 block buffer for directory segments
- name1: .blkb 12
- name2: .blkb 12
-
- .save
- .psect rtdir1 ,rw,d,gbl,rel,con
- contex: .word 0 ; current file number
- hd.fir: .word 0 ; block number of first entry
- itsopen:.word 0
- time: .word 0,45
- devtyp: .word 0
- .restore
- junk: .blkb 20
-
-
-
-
-
-
-
-
-
-
- ; information from the directory header
-
- h$nseg = 0 ; offset for segment count in buffer
- h$next = 2 ; offset for next block link
- h$max = 4 ; offset for highest segment in use
- h$ext = 6 ; offset for number of extra words
- h$blk = 10 ; offset for first block # of data
-
- h.nseg: .blkw 1 ; number of segments in the directory
- h.next: .blkw 1 ; link to the next directory segment
- h.max: .blkw 1 ; max segment actually in use
- h.ext: .blkw 1 ; number of extra words per entry
- h.blk: .blkw 1 ; data block number for the segment
-
-
- ; information from the current directoty entry
-
- f.stat = 0 ; entry status word
- f.nam = 2 ; all three words of the name+type
- f.nam1 = 2 ; first three rad50 characters of name
- f.nam2 = 4 ; last three rad50 characters of name
- f.type = 6 ; all three rad50 characters of type
- f.len = 10 ; file size
- f.misc = 12 ; we don't care about this stuff
- f.date = 14 ; creation date
-
-
- .save
- .psect rtdir1 ,rw,d,gbl,rel,con
- loklen: .word 0 ;/38/ added for server
- lokdate:.word 0 ;/38/ added for server
- dirsiz: .blkw 1 ; total size of a directory entry
- filnam: .blkw 4 ; the .csispc parsed filename+type
- resnam: .blkw 4 ; the name we found
- .restore
-
- .psect
-
-
-
-
-
-
-
-
-
-
- .psect $code
-
- lookup::save <r1,r2,r3> ; save all the temps please
- copyz 2(r5) ,6(r5) ; return the passed name for starters
- tst nowild ;/51/ Perhaps send a DEVICE?
- beq 30$ ;/51/ No
- clr r0 ;/51/ Assume success
- tst @4(r5) ;/51/ Second time for sending device?
- beq 20$ ;/51/ No
- mov #ER$NMF ,r0 ;/51/ Yes, br 100$ all done
- br 100$ ;/51/ Exit
- 20$: inc @4(r5) ;/51/ Success, increment context.
- br 100$ ;/51/ Exit
-
- 30$: tst @4(r5) ; new call sequence today?
- bne 40$ ; no
- clr context ; yes, flag so
- clr h.max ; also init a flag
- .close #lun.sr ; close the old device up also
- clr r0 ; no errors please
- clr itsopen ; device is no longer open
-
- 40$: tst itsopen ; need to open it up
- bne 50$ ; no, already established a context
- call opndev ; get the disk opened up please
- tst r0 ; any errors ?
- bne 100$ ; yes, we will have to die then
- mov sp ,itsopen ; device is open for next call
- 50$: call getnth ; lookup the next one please
- tst r0 ; errors ?
- bne 90$ ; no
- inc @4(r5) ; return correct context
- br 100$
-
- 90$: push r0 ; yes, close the device please
- .close #lun.sr ; close the device up on errors
- clr context ; insure current context is cleared
- clr itsopen ; insure we do an open next time
- pop r0 ; restore the error code now
-
- 100$: unsave <r3,r2,r1> ; pop temps and exit please
- return ; return any errors in r0
-
-
-
-
-
-
-
-
-
-
- .sbttl print directory listing
-
-
-
- ; D O D I R
- ;
- ; input: @r5 wildcarded filespec
- ; output: r0 error code
- ;
- ; DODIR prints a directory listing at the local terminal.
- ;
- ;
- ; S D O D I R
- ;
- ; Passed: @r5 wildcarded name
- ; Return: r0 error code, zero for no errors
- ; r1 next character in the directory listing
- ;
- ; SDODIR is called by the server to respond to a remote directory
- ; command. Instead of the pre 2.38 method of dumping output to a
- ; disk file and then sending the disk file in an extended replay,
- ; SDODIR returns the next character so that BUFFIL can use it.
- ; The routine GETCR0 is actually a dispatch routine to call the
- ; currently selected GET_NEXT_CHARACTER routine.
-
-
- .save
- .psect dirmap ,rw,d,gbl,rel,ovr
- dirnam: .blkw 1 ;/51/ Filled in at startup
- dirbfr: .blkw 1 ;/51/ Ditto
-
- .psect rtdir1 ,rw,d,gbl,rel,con
- diridx: .word 0
- dirptr: .word 0
- wild: .asciz /*.*/
- dspace: .byte 40,0
- dcrlf: .byte 15,12,0
- .even
- .restore
-
-
-
-
- dodir:: save <r1,r2,r3,r5> ; save these please
- mov 2(r5) ,outlun
- 10$: mov @r5 ,-(sp)
- mov #1 ,-(sp)
- mov sp ,r5
- call .dodir
- cmp (sp)+ ,(sp)+
- 100$: unsave <r5,r3,r2,r1>
- clr r0
- return
-
-
- .dodir: tst itsopen ; need to open it up
- beq 10$ ; yes
- .close #lun.sr ; please close up shop first
- clr itsopen ; say it's closed now
- 10$: call opndev ; get the disk opened up please
- tst r0 ; any errors ?
- bne 100$ ; yes, we will have to die then
- mov sp ,itsopen ; device is open for next call
- 50$: call pridir ; lookup the next one please
- tst r0 ; errors ?
- beq 50$ ; no
-
- 90$: mov r0 ,-(sp) ; yes, close the device please
- .close #lun.sr ; close the device up on errors
- clr itsopen ; insure we do an open next time
- mov (sp)+ ,r0 ; restore the error code now
-
- 100$: return ; return any errors in r0
-
-
-
-
-
-
-
-
-
-
- .sbttl SDODIR directoty stuff for a server
-
-
- sdirin::strcpy dirnam ,@r5 ; copy name over
- mov dirbfr ,dirptr ; yes, init pointers please
- clr diridx ; ditto
- call dirini ; init for calls to sdodir
- bcs 100$
- mov dirbfr ,dirptr ; yes, init pointers please
- clrb @dirptr ; yes, zap the buffer
- call dirnex ; preload buffer
- 100$: return
-
-
- sdodir::save <r2,r3,r4>
- 10$: movb @dirptr ,r1 ; get the next character please
- bne 20$ ; something was there
- mov dirbfr ,dirptr ; reset the pointer
- clrb @dirptr ; yes, zap the buffer
- call dirnex ; empty buffer, load with next file
- bcs 90$ ; no more, return ER$EOF
- br 10$ ; and try again
- 20$: inc dirptr ; pointer++
- clr r0 ; no errors
- br 100$ ; exit
- 90$: mov #ER$EOF ,r0 ; failure, return(EOF)
- 95$: clr r1 ; return no data also
- clr diridx ; init for next time through
- 100$: unsave <r4,r3,r2>
- return
-
-
-
- dirini: clr diridx ; clear context flag
- mov dirbfr ,dirptr ; set pointer up for SDODIR
- clrb @dirptr ; clear buffer
- return ; thats all folks
-
-
-
- dirnex: movb defdir ,-(sp) ; anything in DEFDIR ?
- bne 10$ ; yes, don't alter it please
- strcpy #defdir ,#wild ; nothing, insert *.*;*
- 10$: mov dirbfr ,r2 ; pointer to buffer
- mov #junk ,r3 ; pointer to work buffer
- calls lookup ,<#3,dirnam,#diridx,r2>
- tst r0 ; successfull?
- bne 80$ ; no
- strlen r2 ; get the length of the string
- mov #20 ,r1 ; and format the string
- sub r0 ,r1 ; number of spaces to append
- ble 30$ ; can't happen
- 20$: strcat r2 ,#dspace ; append spaces please
- sob r1 ,20$ ; next please
- 30$: deccvt loklen ,r3 ; filesize
- clrb 6(r3) ; insure .asciz please
- strcat r2 ,r3 ; append it please
- strcat r2 ,#dspace ; a space
- mov lokdate ,r0 ; get date converted
- bne 40$ ; valid
- dec r0 ; invalid, force 00-xxx-00
- 40$: calls cvtdat ,<r3,r0>,nogbl ; append the date please
- strcat r2 ,r3 ;
- strcat r2 ,#dcrlf ; yes, append <cr><lf>
- clr r0 ; success
- br 100$ ; exit
- 80$: cmp r0 ,#ER$NMF ; no more files error ?
- bne 90$ ; no
- tst diridx ; ever do anything?
- bne 90$ ; yes
- mov #ER$FNF ,r0 ; no, convert to file not found
- 90$: sec
- 100$: movb (sp)+ ,defdir ; restore DEFDIR
- return
-
-
-
-
-
-
-
-
-
-
-
- .sbttl open the disk up to search the directory
-
- opndev: .SERR ;/51/ Trap fatal errors please
- sub #20. ,sp ; allocate buffer for the
- mov sp ,r2 ; device status call
- sub #40.*2 ,sp ; allocate a buffer for the
- mov sp ,r1 ; .csispc data
-
- 1$: mov #defdir ,r3 ; insert default device name
- scan #': ,2(r5) ; check for a device already there
- tst r0 ; well ?
- bne 6$ ; yep. don't try to put one in please
- 5$: movb (r3)+ ,@r1 ; copy it
- beq 6$ ; all done
- inc r1 ; not null, next please
- br 5$ ;
- 6$: mov 2(r5) ,r0 ; string address
- 10$: movb (r0)+ ,(r1)+ ; copy it to the csi buffer
- bne 10$ ; until a null byte is found.
- dec r1 ; get back to the last character
- cmpb -1(r1) ,#': ; is the just just a device only?
- bne 15$ ; no
- movb #'* ,(r1)+ ; yes, insert *.*
- movb #'. ,(r1)+ ; yes, insert *.*
- movb #'* ,(r1)+ ; yes, insert *.*
- 15$: movb #'= ,(r1)+ ; fake an output filespec here
- clrb @r1 ; and .asciz
- mov sp ,r1 ; reset pointer (also saving sp)
- .csispc r1,#defext,r1 ; and try to parse the name
- mov r1 ,sp ; restore from any switches
- bcs 80$ ; oops
- calls fetch ,<@r1> ; try to get the thing loaded
- tst r0 ; well ?
- bne 120$ ; no, exit with mapped error
- mov devidx ,devtyp ;/45/ Save device type from .FETCH
- 20$: tst @r1 ; a specific device name ?
- bne 30$ ; yes
- mov #^RDK ,@r1 ; no, stuff DK: into it then
-
- 30$: mov r1 ,r0 ; copy the pointer to .csispc results
- mov #filnam ,r2 ; and save the results
- mov (r0)+ ,(r2)+ ; copy the device spec first of all
- mov @r0 ,(r2)+ ; copy the first 3 rad50 of filename
- bne 40$ ; something was indeed there
- mov #star ,-2(r2) ; nothing, convert to wilcard
- 40$: clr (r0)+ ; and clear any filenames please
- mov @r0 ,(r2)+ ; copy the last 3 rad50 of filename
- clr (r0)+ ; and clear any filenames please
- mov @r0 ,(r2)+ ; copy the 3 rad50 of filetype
- .if eq,-1 ;/58/ not longer implied wildcard here
- bne 50$ ; something was passed for filetype
- mov #star ,-2(r2) ; nothing there, stuff a wilcard in
- .endc
- 50$: clr (r0)+ ; and clear any filetypes please
- clr (r0)+ ; to be sure
- .lookup #rtwork,#lun.sr,r1 ; open the file for input
- bcs 100$ ; can not find it
- clr r0 ; no errors
- br 120$ ; and exit
-
- 60$: mov #dsterr ,r1
- br 110$
- 80$: mov #csierr ,r1 ; .csispc error mapping
- br 110$ ; get the correct error now
- 90$: mov #feterr ,r1 ; .fetch error codes
- br 110$
- 100$: mov #lokerr ,r1 ; .lookup error mapping
- br 110$
-
- 110$: movb @#errbyt,r0 ; get the error code now
- bpl 115$ ;/51/ Normal RT11 error
- com r0 ;/51/ Make positive
- add #faterr ,r0 ;/51/ Map to fatal error list
- 115$: asl r0 ; times 2 for indexing into error map
- add r0 ,r1 ; now map the rt11 error into a fake
- mov @r1 ,r0 ; of a rms11 error
-
- 120$: add #<40.*2>+20.,sp ; pop all the tiny buffers now.
- push r0 ;/51/ Successfull?
- beq 130$ ;/51/ Yes
- .PURGE #LUN.SR ;/51/ No, purge the channel now
- 130$: .HERR ;/51/ Restore normal error control
- pop r0 ;/51/ Pop actual error code
- return ; and get out
-
-
- .save
- .psect rtdir
- defext: .word star,star,star,star ;/58/ default ext. are wildcards
- .restore
-
-
-
-
-
-
-
-
-
-
- .sbttl read the home block in please
-
- gethom: save <r1,r2> ;/54/
- .readw #rtwork,#lun.sr,#dirbuf,#400,#hd$blk
- bcs 90$ ; it failed, bye
- mov #dirbuf ,r2 ; point to the buffer now
- mov hd$fir(r2),hd.fir ; get the first directory block number
- bne 5$ ; /56/
- mov #6 ,hd.fir ; /56/ Disk had no init data
- 5$: add #hd$sys ,r2 ; point to the volume ident
- cmpb devtyp ,#DEV$LD ;/45/ Logical disk ?
- beq 30$ ;/45/ Yes, skip the check
- tst rtvol ; really verify volume ?
- beq 30$ ; no
- mov r2 ,r1 ;/54/ Check
- mov #rt ,r0 ;/54/ ...
- 10$: tstb @r0 ;/54/ Done
- beq 30$ ;/54/ Yes, exit
- cmpb (r0)+ ,(r1)+ ;/54/ Same
- beq 10$ ;/54/ Yes, keep looking
- mov r2 ,r1 ;/54/ Check
- mov #vms ,r0 ;/54/ ...
- 20$: tstb @r0 ;/54/ Done
- beq 30$ ;/54/ Yes, exit
- cmpb (r0)+ ,(r1)+ ;/54/ Same
- beq 20$ ;/54/ Yes, keep looking
- br 80$ ;/54/ Not valid
- 30$: clr r0 ; no errors
- br 100$ ; and exit
-
- 80$: mov #er$vol ,r0 ; return an error code and exit
- br 100$ ; bye
-
- 90$: movb @#errbyt,r0 ; get the error code
- asl r0 ; times two
- mov reaerr(r0),r0 ; map it into a unique global error
-
- 100$: unsave <r2,r1> ;/54/
- return ; bye
-
- .save ;/54/
- .psect $PDATA D ;/54/
- rt: .asciz /DECRT11/ ;/54/
- vms: .asciz /DECVMSEX/ ;/54/ From EXCHANGE under VMS4.x
- .even ;/54/
- .restore ;/54/
-
-
- gethdr: .readw #rtwork,#lun.sr,#dirbuf,#1000,r1
- bcs 90$ ; it failed, bye
- mov #dirbuf ,r0 ; point to the buffer now
- mov h$nseg(r0),h.nseg ; get the total segment count now
- asl h$next(r0) ; segments are two blocks in length
- beq 5$ ; no more segments if zero
- add #4 ,h$next(r0) ; and at last, the offset
- 5$: mov h$next(r0),h.next ; get the link to the next one
- tst h.max ; already set up ?
- bne 10$ ; yes, don't touch it please
- mov h$max(r0) ,h.max ; get the maximum segment in use
- 10$: mov h$ext(r0) ,h.ext ; get the extra words per dir entry
- mov h$blk(r0) ,h.blk ; and the starting block for data
- mov #7*2 ,dirsiz ; the default entry size
- add h$ext(r0),dirsiz ; plus extra bytes per entry
- clr r0 ; no errors
- br 100$ ; and exit
-
- 90$: movb @#errbyt,r0 ; get the error code
- asl r0 ; times two
- mov reaerr(r0),r0 ; map it into a unique global error
-
- 100$: return ; bye
-
-
- global <rtvol>
-
-
-
-
-
-
-
-
-
-
- .sbttl print the directory out
-
-
-
- pridir: save <r1,r2,r3> ; save temps
- call gethom ; read in the home block
- tst r0 ; did it work ?
- bne 100$ ; no, exit with the error please
- mov hd.fir ,r1 ; get this directory entry
- 10$: tst r1 ; end of the directory list ?
- beq 90$ ; yes, return 'no more files' please
- call gethdr ; the the first directory header
- tst r0 ; did this work out ?
- bne 100$ ; no, return mapped error code please
- mov #dirbuf ,r3 ; point to the directory buffer
- add #5*2 ,r3 ; skip past the header information
- 20$: bit #endseg ,f.stat(r3) ; end of this segment ?
- bne 80$ ; yes, try the next one please
- bit #perm ,f.stat(r3) ; is this a real file ?
- beq 70$ ; no, skip it please
- call match ; see if the file matches up
- tst r0 ; well ?
- beq 70$ ; no, try again please
- mov #junk ,r2 ; a local buffer to use
- call convert ; convert to asciz
- mov #junk ,-(sp) ; push the buffer address
- call 110$ ; dump it please
- deccvt f.len(r3),#junk ; convert size to decimal
- clrb junk+6 ; insure .asciz please
- mov #junk ,-(sp) ; push the buffer address
- call 110$ ; and do it
- mov #210$ ,-(sp) ; push buffer
- call 110$ ; dump it
- mov f.date(r3),r0 ; a real date today?
- bne 60$ ; yes
- dec r0 ; no, force 00-xxx-00
- 60$: calls cvtdat ,<#junk,r0>,nogbl; and convert the date
- mov #junk ,-(sp) ; same again
- call 110$ ;
- mov #200$ ,-(sp) ;
- call 110$ ;
-
-
- 70$: add dirsiz ,r3 ; skip to the next entry please
- br 20$ ; and check this one out please
- 80$: mov h.next ,r1 ; end of segment, check the next one
- br 10$ ; simple to do
-
- 90$: mov #er$nmf ,r0
-
- 100$: unsave <r3,r2,r1> ; pop temps and exit
- return
-
-
- 110$: save <r0,r1,r2,r3> ; save registers
- mov 12(sp) ,r3 ; get the buffer address
- tst outlun ; output to disk or terminal
- beq 150$ ; tt:
- strlen r3 ; disk, get the buffer size
- mov r0 ,r2 ; save it please
- beq 190$ ; nothing to do
- 120$: movb (r3)+ ,r0 ; get the next character
- mov outlun ,r1 ; set the lun up also
- call putcr0 ; dump the character
- sob r2 ,120$ ; and get the next one
- br 190$ ; exit
- 150$: .print r3 ; output to tt:
- 190$: unsave <r3,r2,r1,r0> ; pop registers and exit
- mov (sp)+ ,(sp) ; move return address up and exit
- return ; bye
-
-
- 200$: .byte 15,12,0
- 210$: .byte 40,40,40,0
- .even
-
-
-
-
-
-
-
-
-
-
- .sbttl get the next entry matching a possibly wildcarded name
-
-
- getnth: save <r1,r2,r3,r4> ; save temps
- clr r4 ; counter for number of matches
- call gethom ; read in the home block
- tst r0 ; did it work ?
- bne 100$ ; no, exit with the error please
- mov hd.fir ,r1 ; get this directory entry
- 10$: tst r1 ; end of the directory list ?
- beq 90$ ; yes, return 'no more files' please
- call gethdr ; the the first directory header
- tst r0 ; did this work out ?
- bne 100$ ; no, return mapped error code please
- mov #dirbuf ,r3 ; point to the directory buffer
- add #5*2 ,r3 ; skip past the header information
-
- 20$: bit #endseg ,f.stat(r3) ; end of this segment ?
- bne 80$ ; yes, try the next one please
- bit #perm ,f.stat(r3) ; is this a real file ?
- beq 70$ ; no, skip it please
- call match ; see if the file matches up
- tst r0 ; well ?
- beq 70$ ; no, try again please
- cmp r4 ,context ; a match here ?
- bne 50$ ; no, try again please
- mov 6(r5) ,r2 ; a buffer to convert into
- call convert ; convert to asciz
- mov r2 ,r0 ; not get rid off ALL spaces in the name
- 30$: tstb @r0 ; end of the string yet ?
- beq 40$ ; yes
- cmpb @r0 ,#40 ; if it's a space, then ignore it
- beq 35$ ; skip it please
- movb @r0 ,(r2)+ ; not a space, please copy it then
- 35$: inc r0 ; point to the next character now
- br 30$ ; and check the next character please
- 40$: clrb @r2 ; insure returned string is .asciz
- mov F.DATE(r3),lokdate ;/38/ save this
- mov F.LEN(r3),loklen ;/38/ save this
- clr r0 ; success
- inc context ; next one next time please
- br 100$ ; bye
- 50$: inc r4 ; matches := succ( matches )
- br 70$ ; next try please
-
- 70$: add dirsiz ,r3 ; skip to the next entry please
- br 20$ ; and check this one out please
- 80$: mov h.next ,r1 ; end of segment, check the next one
- br 10$ ; simple to do
-
- 90$: mov #er$nmf ,r0
-
- 100$: unsave <r4,r3,r2,r1> ; pop temps and exit
- return
-
-
-
-
-
-
-
-
-
-
- .sbttl convert current directory entry to asciz
-
- ; input: r2 buffer for the result
- ; r3 current directory entry pointer
-
-
- convert:mov r2 ,-(sp) ; save the passed pointer to a buffer
- calls rdtoa ,<r2,filnam> ; convert the device name please
- cmpb @r2 ,#40 ; a space for device name ?
- bne 10$ ; no
- movb #'D&137 ,@r2 ; yes, stuff 'DK' in please
- movb #'K&137 ,1(r2) ; simple to do
- 10$: add #2 ,r2 ; skip past it and insert a ':'
- cmpb @r2 ,#40 ; a space (no unit number?)
- beq 20$ ; no
- tstb (r2)+ ; a real unit, skip over number
- 20$: movb #': ,(r2)+ ; yes, get DD: format of device name
- calls rdtoa ,<r2,f.nam1(r3)>; convert first 3 filename to ascii
- add #3 ,r2 ; and skip over those three characters
- calls rdtoa ,<r2,f.nam2(r3)>; now get the rest of the filename
- add #3 ,r2 ; point to place a dot into the name
- movb #'. ,(r2)+ ; a dot
- calls rdtoa ,<r2,f.type(r3)>; get the filetype at last
- clrb 3(r2) ; and insure .asciz please
- mov (sp)+ ,r2 ; pop the pointer and exit
- return ; bye
-
- .enabl lsb
-
- percent = '. ;/58/ percent in a filspc string
- wildc = '? ;/58/ wildcard flag
-
- match: save <r1,r2> ; we may need these here
- mov filnam+2,rtwork+0 ; copy the name and type please
- mov filnam+4,rtwork+2 ; copy the name and type please
- mov filnam+6,rtwork+4 ; copy the name and type please
- mov #name1 ,r1 ; was not a simple pattern so convert
- mov #rtwork ,r2 ; both names back to ascii and check
- mov #3 ,r0 ; for individual character wildcarding
- 40$: calls rdtoa ,<r1,(r2)+> ; convert the patter filename back
- add #3 ,r1 ; increment the pointer by 3 char's.
- sob r0 ,40$ ; next please
- ;
- mov #name2 ,r1 ; a buffer for the file we just found
- mov r3 ,r2 ; on the disk. Now get the address of
- add #f.nam1 ,r2 ; the name and filetype, convert this
- mov #3 ,r0 ; to ascii in a loop
- 50$: calls rdtoa ,<r1,(r2)+> ; convert
- add #3 ,r1 ; next please
- sob r0 ,50$ ;
- ;
- 60$: mov #name1 ,r1 ; the filename pattern
- mov #name2 ,r2 ; the current filename on disk
- mov #6. ,r0 ; the loop count for scanning
- call 200$ ;/58/ compare filename
- bcs 90$ ;/58/ /B on match failure
- mov #name1+6,r1 ; the filetype pattern
- mov #name2+6,r2 ; the current filetype on disk
- mov #3. ,r0 ; the loop count for scanning
- call 200$ ;/58/ compare filetype
- bcs 90$ ;/58/ /B on match failure
- mov sp ,r0 ; flag success and exit
- br 100$ ; bye
- ;
- 90$: clr r0 ; failure, exit
- ;
- 100$: unsave <r2,r1> ; restore registers
- return ; and exit at last
- ;
- 200$: mov r0 ,311$ ;/58/ save for later re-use
- mov r1 ,310$ ;/58/
- 201$: cmpb @r1 ,@r2 ;/58/ if they match, no problem
- beq 202$ ;/58/ simply check the next character
- cmpb @r1 ,#wildc ;/58/ a translated "* wildcard ?
- beq 210$ ;/58/ yes - alternativ check
- cmpb @r1 ,#percent ;/58/ a translated "% wildcard ?
- bne 231$ ;/58/ no - match failure ...
- 202$: inc r1 ;/58/ match so far,
- inc r2 ;/58/ update pointers
- sob r0 ,201$ ;/58/ and check the next ones
- call 300$ ;/58/ are we at end of string?
- bcs 230$ ;/58/ yes - success
- cmpb @r1 ,#space ;/58/ no - see if wildcarded
- beq 230$ ;/58/ if so, success
- br 231$ ;/58/ else failure ...
- ;/58/
- 210$: inc r1 ;/58/ point to char. after wildc
- call 300$ ;/58/ are we at end of string?
- bcs 230$ ;/58/ if so, success ...
- 211$: cmpb @r1 ,#space ;/58/ a spaces?
- beq 230$ ;/58/ end of matching check
- cmpb @r1 ,#percent ;/58/ a translated "% wildcard ?
- bne 220$ ;/58/ no - compare strings
- inc r1 ;/58/ point to char. after wildc
- sob r0,211$ ;/58/ otherwise loop to find a char.
- br 230$ ;/58/ all "%'s - assume success
- ;/58/
- 220$: cmpb @r1 ,@r2 ;/58/ find a matching character
- bne 221$ ;/58/ not yet, see next ...
- cmpb 1(r2) ,@r2 ;/58/ next = same?
- bne 202$ ;/58/ no - verify remainder
- 221$: inc r2 ;/58/ else point to next
- sob r0,220$ ;/58/ and loop until done
- br 231$ ;/58/ match failure
- ;/58/
- 230$: tst (pc)+ ;/58/ bump next instr. and clr carry
- 231$: sec ;/58/ flag failure
- return ;/58/ back to caller
- ;/58/
- 300$: push r0 ;/58/ save temp
- mov r1 ,r0 ;/58/ copy searched string pointer
- sub (pc)+ ,r0 ;/58/ make match count
- 310$: .word 0 ;/58/ searched string base address
- cmp (pc)+ ,r0 ;/58/ compare with char. count
- 311$: .word 0 ;/58/ string width
- beq 320$ ;/58/ yes - flag end string
- tst (pc)+ ;/58/ else skip next instr.
- 320$: sec ;/58/ flag end-of-string
- pop r0 ;/58/ restore reg
- return
-
- .dsabl lsb
-
-
-
-
-
-
-
-
-
- .sbttl ascdat convert to ascii date for RT11
- .mcall .date
-
-
- ; input: @r5 output buffer address
- ; 2(r5) value of date, zero implies current
- ;
- ; I certainly could use my ASH and DIV macros, but may as
- ; well do it this way for future possibilities.
- ;
- ; N O T E : This is a LOCAL copy of ASCDAT so I can overlay
- ; the real ACSDAT oppossing this overlay.
-
-
-
- cvtdat: save <r0,r1,r2,r3> ; save these please
- mov @r5 ,r1 ; the result address
- cmp 2(r5) ,#-1 ; if -1, then return 00-XXX-00
- bne 5$ ; no
- copyz #310$ ,r1 ; yes, then exit
- br 100$ ; bye
- 5$: mov 2(r5) ,r0 ; get the date desired please
- bne 10$ ; it's ok
- .date ; zero, assume todays date then
- 10$: bic #100000 ,r0 ; undefined
- mov r0 ,r3 ; copy the date
- asr r3 ;/2
- asr r3 ;/2 again
- asr r3 ; ditto
- asr r3 ; sigh
- asr r3 ; at last
- bic #^C37 ,r3 ; the date, at last
- call 200$ ; convert it
- mov r0 ,r3 ; get the date once again please
- swab r3 ; get the month to bits 2..7
- asr r3 ;/2
- asr r3 ;/2 again
- bic #^C17 ,r3 ; get rid of the unwanted bits now
- dec r3 ; convert to 0..11
- asl r3 ; convert to word offset
- asl r3 ; quad offset
- add #300$ ,r3 ; the address of the text
- movb #'- ,(r1)+ ; copy it over please
- movb (r3)+ ,(r1)+ ; three characters please
- movb (r3)+ ,(r1)+ ; three characters please
- movb (r3)+ ,(r1)+ ; three characters please
- movb #'- ,(r1)+ ; copy it over please
- mov r0 ,r3 ; copy the date
- bic #^C37 ,r3 ; the year, at last
- add #110 ,r3 ; plus the bias please
- call 200$ ; convert
- clrb @r1 ; .asciz and exit
- 100$: unsave <r3,r2,r1,r0>
- return
-
- 200$: clr r2 ; subtract 10 a few times
- 210$: inc r2 ; high digit number
- sub #12 ,r3 ; until we get a negative number
- tst r3 ; done yet ?
- bge 210$ ; no
- dec r2 ; yes
- add #12 ,r3 ; correct it please
- add #'0 ,r2 ; and copy the day number please
- add #'0 ,r3 ; simple
- movb r2 ,(r1)+ ; copy it
- movb r3 ,(r1)+ ; copy it
- return
-
- .nlist bex
- 300$: .ascii /Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec /
- 310$: .asciz /00-XXX-00/
- .list bex
- .even
-
-
-
- .end
-